MAG — S2 WRANGLING EDA
ANONYMIZED
2024-02-04
1 WRANGLING
Initial data were collected via Qualtrics surveys named
MAG_S2_PROLIFIC-DATACOLLAR_0 and
MAG_S2_PROLIFIC-DATACOLLAR_0, each presenting participants
with one common graph (“block 0”, STIMULUS = B0-0) and four
subsequent graphs in random order (“block 1”). The 24 stimuli are
organized in 6 blocks, and we started by collecting data for block 1 to
test data quality and runtime of the survey instrument.
Notes on Qualtrics Survey Status
In Qualtrics, when a survey is:
abandoned; Finished = False and Progress < 100%
fails consent or pre-screening, Finished = TRUE, Progress = 100%, Q_TerminateFlag = “Screened”
complete; Finished = TRUE, Progress = 100%
#### RAW DATA ####################################################################
# will always be the unaltered version of imported data
# 1 row per subject
# drop first two rows (qualtrics_specs)
df_raw_datacollar <- read_csv("data/input/CLEAN_MAG_S2_PROLIFIC-DATACOLLAR_B1.csv", col_names = TRUE)
df_raw_datacollar <- df_raw_datacollar[-c(1:2),]
df_raw_bluecollar <- read_csv("data/input/CLEAN_MAG_S2_PROLIFIC-BLUECOLLAR_B1.csv", col_names = TRUE)
df_raw_bluecollar <- df_raw_bluecollar[-c(1:2),]
df_raw <- rbind(df_raw_datacollar, df_raw_bluecollar)
rm(df_raw_datacollar, df_raw_bluecollar)
#### MASTER WIDE FORMAT DATA FRAME [1 row / qualtrics submission] ################
# drop first two rows (qualtrics_specs)
df_raw_clean <- df_raw %>%
select(
-EndDate, -IPAddress, -RecordedDate,
-RecipientLastName, -RecipientFirstName, -RecipientEmail,
-ExternalReference, -LocationLatitude, -LocationLongitude,
-DistributionChannel, -UserLanguage, -Q_RecaptchaScore,
-P_BROWSER_Version, -P_BROWSER_Resolution,
-CONSENT, -ELIGIBILITY,
-randomize_common, -stimulus_common, #hidden q that controls common stimulus url
-FL_14_DO, #not actually randomization order
-contains("First Click"), -contains("Last Click"), -contains("Click Count"),
-T_EMAIL, -T_BROWSER_Version, -T_BROWSER_Resolution,
-D_politicalParty_DO,
-ID_PROLIFIC, -ID_STUDY, -ID_SESSION #redundant to other cols
) %>%
rename(
duration.sec = `Duration (in seconds)`,
EndState = End_State,
TerminateFlag = Q_TerminateFlag,
Source = Status, #where the survey originated from (should not be preview or test)
PLATFORM = Q_PLATFORM,
ID.Qualtrics = ResponseId,
ID.Prolific = PROLIFIC_PID,
ID.Study = STUDY_ID,
ID.Session = SESSION_ID,
P_BROWSER_OS = `P_BROWSER_Operating System`,
T_BROWSER_OS = `T_BROWSER_Operating System`,
SCREEN_workFunction_TEXT = SCREEN_workFunction_22_TEXT,
SCREEN_socialMedia_TEXT = SCREEN_socialMedia_18_TEXT,
D_politicalParty_OTHER = D_politicalParty_4_TEXT,
D_politicsSocial = D_politicsSocial_1,
D_politicsFiscal = D_politicsFiscal_2
) %>%
mutate(
# STUDY IDS
# 65ceb65b05030d95c598ef1b - blue collar
# 65c53fd727dceff9fd360b09 - data collar
D_politicsSocial = as.numeric(D_politicsSocial),
D_politicsFiscal = as.numeric(D_politicsFiscal),
ID.Study = factor(ID.Study,
levels = c("65c53fd727dceff9fd360b09", "65ceb65b05030d95c598ef1b"),
labels = c("datacollar","bluecollar")),
# StartDate = mdy_hm(StartDate),
duration.sec = as.numeric(duration.sec), #weird booleans should only be for the test generator
duration.min = round(duration.sec/60,2),
Progress = as.numeric(Progress),
D_education = factor( D_education,
levels = c(
"NA",
"Some high school or less",
"High school diploma or GED",
"Associates or technical degree",
"Some college, but no degree",
"Graduate or professional degree (MA, MS, MBA, PhD, JD, MD, DDS etc.)"
),
labels = c(
"NA",
"< HS",
"HS/GED",
"Associates",
"Some college",
"Grad/Proff"
)
),
D_politicalParty = factor(D_politicalParty, levels = c("NA", "Independent", "Democrat", "Republican", "Other")),
D_age = factor(D_age,
levels = c("25-34 years old" ,
"18-24 years old" ,
"45-54 years old" ,
"35-44 years old" ,
"65+ years old" ,
"55-64 years old"),
labels = c("25-34", "18-24", "45-54","35-44","65+ years","55-64"))
) %>%
rename_at(
#REPLACE RANDOM TRAILING _1 AND _65 FROM QUALTRICS
vars(contains('_65')), funs(sub('_65', '', .))
) %>%
rename_at(
vars(contains('_1')), funs(sub('_1', '', .))
) %>%
rename_at(
vars(contains('_Page Submit')), funs(sub('_Page Submit', '', .))
) %>%
rename_at( #CHANGE DETAIL QUESTION DELIMITER FOR PIVOT PURPOSES
vars(contains('_CHART_')), funs(sub('_CHART_', '_CHART-', .))
) %>%
rename_at( #CHANGE DETAIL QUESTION DELIMITER FOR PIVOT PURPOSES
vars(contains('_MAKER_')), funs(sub('_MAKER_', '_MAKER-', .))
) %>%
rename_at( #CHANGE DETAIL QUESTION DELIMITER FOR PIVOT PURPOSES
vars(contains('_AGE_')), funs(sub('_AGE_', '_AGE-', .))
) %>%
rename_at( #CHANGE DETAIL QUESTION DELIMITER FOR PIVOT PURPOSES
vars(contains('_GENDER_')), funs(sub('_GENDER_', '_GENDER-', .))
) %>%
rename_at( #CHANGE DETAIL QUESTION DELIMITER FOR PIVOT PURPOSES
vars(contains('_TOOL_')), funs(sub('_TOOL_', '_TOOL-', .))
) %>%
select ( #reodering
ID.Qualtrics, ID.Prolific:ID.Session,
Source, Progress, Finished, EndState, TerminateFlag,
StartDate, duration.min, PLATFORM,
P_BROWSER_Browser, P_BROWSER_OS, T_BROWSER_Browser, T_BROWSER_OS,
D_gender:D_politicsFiscal, SCREEN_workMethod:SCREEN_socialMedia_TEXT,
PURPOSE, FEEDBACK ,
`0_Q_B0_ENCOUNTER`:`4_Q_B6_CHART-LATENCY`
) %>%
mutate ( #set factors
ID.Qualtrics = factor(ID.Qualtrics),
ID.Prolific = factor(ID.Prolific),
# ID.Study = factor(ID.Study),
ID.Session = factor(ID.Session),
PLATFORM = factor(PLATFORM),
Source = factor(Source),
Finished = as.logical(Finished),
TerminateFlag = factor(TerminateFlag)
)
#### SEGREGATE PARTICIPANTS WHO DID NOT COMPLETE ###############################
## [1 row / qualtrics submission] ################
## NOTE it is common for prolific participants to fail the
## screening verification, and then try again but change their
## screening verification answers (ie. one prolific ID for multiple qualrics IDs)
df_nofinish <- df_raw_clean %>%
filter(
!is.na(TerminateFlag) | Finished == FALSE
) %>%
select(
ID.Qualtrics, ID.Prolific, ID.Study, Source, Progress,
Finished, TerminateFlag, EndState) %>%
mutate(
EndState = ifelse( (Progress < 100), "abandoned", EndState)
)
#### MASTER VALID DATA [WIDE] 1 row per qualtrics entry #########################
## [1 row / qualtrics submission] ################
df_data <- df_raw_clean %>% filter(
ID.Qualtrics %nin% df_nofinish$ID.Qualtrics
# (Finished == TRUE ) & is.na(TerminateFlag)
)
#sanity check === SHOULD BE O
#no qualtrics surveys in good data that weren't finished
print("Number of Qualtrics entries in df_data AND nofinish? [should be 0]")## [1] "Number of Qualtrics entries in df_data AND nofinish? [should be 0]"sum(df_data$ID.Qualtrics %in% df_nofinish$ID.Qualtrics)## [1] 0#sanity check === SHOULD BE O
#no duplicated PROLIFIC ids in good data
print("Number of Prolific IDs duplicated in df_data print [should be 0]")## [1] "Number of Prolific IDs duplicated in df_data print [should be 0]"sum(duplicated(df_data$ID.Prolific))## [1] 0#### QUESTION LEVEL DATA FRAME (LONG) ##########################
# unravel ALL the way down to questions
# 1 row per participant-graph-question
df_questions <- df_data %>%
select(
ID.Qualtrics:ID.Study, PLATFORM,
contains("_Q_"), contains("loop")
) %>%
pivot_longer( #PIVOT ON stimulus
cols = contains("_Q_"),
names_to = c("stimulus","dummy","BLOCK","QUESTION"),
values_to = c("value"),
names_sep = "_"
) %>% select(-dummy) %>%
unite(
BLOCK:stimulus, col="STIMULUS", sep="-", remove=FALSE
) %>%
mutate(
BLOCK = factor(BLOCK),
STIMULUS = factor(STIMULUS),
QUESTION = str_replace_all(QUESTION,"-","_"),
QUESTION = factor(QUESTION)
) %>%
select(-stimulus) %>% filter(!is.na(value))
#### CHART LEVEL DATA FRAME (LONG) ##########################
# 1 row per participant X graph
# unnest https://stackoverflow.com/questions/58035452/pivot-wider-outputs-s3-vctrs-list-of-objects
df_graphs_full <- df_questions %>%
pivot_wider(
names_from = QUESTION,
values_from = value
) %>%
tidyr::unnest() %>% # handle r coerces values to lists
mutate(
across(contains("_ID") | contains("MAKER_GENDER") | contains("MAKER_AGE"), factor),
across(contains("_CONF") | contains("_LATENCY"), as.numeric),
across(MAKER_DESIGN:MAKER_TRUST, as.numeric),
across(CHART_LIKE:CHART_TRUST, as.numeric),
ENCOUNTER = factor(ENCOUNTER),
loop_number = as.numeric(loop_number),
loop_number = ifelse(is.na(loop_number), 0, loop_number),
MAKER_LATENCY = round(MAKER_LATENCY/60,2), #CHANGE TO MINS
CHART_LATENCY = round(CHART_LATENCY/60,2), #CHANGE TO MINS
MAKER_ID = factor( MAKER_ID,levels = c("business", "political", "education","news","organization","individual"))
)
## SUBSET OF COLUMNS EXCLUDING THE FREE RESPONSES
df_graphs <- df_graphs_full %>%
select( !is.character)
#### CHART LEVEL DATA FRAME (LONG) FOR QDA (incl demographics) ##################
# 1 ROW / participant X GRAPH including demographics
# UNRAVEL TO QUESTIONS
df_qda <- df_data %>%
# select(
# ID.Qualtrics:ID.Study, PLATFORM,
# contains("_Q_"), contains("loop")
# ) %>%
pivot_longer( #PIVOT ON stimulus
cols = contains("_Q_"),
names_to = c("stimulus","dummy","BLOCK","QUESTION"),
values_to = c("value"),
names_sep = "_"
) %>% select(-dummy) %>%
unite(
BLOCK:stimulus, col="STIMULUS", sep="-", remove=FALSE
) %>%
mutate(
BLOCK = factor(BLOCK),
STIMULUS = factor(STIMULUS),
QUESTION = str_replace_all(QUESTION,"-","_"),
QUESTION = factor(QUESTION)
) %>%
select(-stimulus) %>%
# RE-RAVEL UP TO STIMULI
filter(!is.na(value)) %>%
pivot_wider(
names_from = QUESTION,
values_from = value
) %>%
tidyr::unnest() %>% # handle r coerces values to lists
mutate(
across(contains("_ID") | contains("MAKER_GENDER") | contains("MAKER_AGE"), factor),
across(contains("_CONF") | contains("_LATENCY"), as.numeric),
across(MAKER_DESIGN:MAKER_TRUST, as.numeric),
across(CHART_LIKE:CHART_TRUST, as.numeric),
ENCOUNTER = factor(ENCOUNTER),
loop_number = as.numeric(loop_number),
loop_number = ifelse(is.na(loop_number), 0, loop_number),
MAKER_LATENCY = round(MAKER_LATENCY/60,2), #CHANGE TO MINS
CHART_LATENCY = round(CHART_LATENCY/60,2) #CHANGE TO MINS
)
#WRITE A CSV FILE AS THE BASIS FOR THE QUALITATIVE DATA ANALYSIS
write.csv(df_qda, file = "data/output/df_qda.csv", na="")
#CHECK BLOCKS PER PARTICIPANT
# every participant should have 2 blocks
check_subject_blocks <- df_questions %>%
group_by(ID.Qualtrics) %>% summarise(
n_block = length(unique(BLOCK))
)
all(check_subject_blocks$n_block==2)## [1] TRUE#CHECK STIMULI PER PARTICIPANT
# every participant should have 5 graphs
check_subject_graphs <- df_questions %>%
group_by(ID.Qualtrics) %>%summarise(
n_graphs = length(unique(STIMULUS))
) #each participant should have five graphs
all(check_subject_graphs$n_graphs==5)## [1] TRUE# title = "Participants by Condition and Data Collection Modality"
# cols = c("Control Condition","Impasse Condition","Total for Period")
print("Number of abandoned/screened no finish attempts")## [1] "Number of abandoned/screened no finish attempts"table(df_nofinish$ID.Study)##
## datacollar bluecollar
## 57 44print("Number of successful surveys")## [1] "Number of successful surveys"table(df_data$ID.Study)##
## datacollar bluecollar
## 20 20# cont %>% addmargins() %>% kbl(caption = title, col.names = cols) %>% kable_classic()
#CLEANUP
rm(check_subject_blocks, check_subject_graphs, df_graphs_qda)
# `r nrow(df_raw)` submissions were received via Qualtrics (`r nrow(df_master %>% filter(ID.Study=="datacollar"))` data-collar, `r nrow(df_master %>% filter(ID.Study=="bluecollar"))` blue-collar). Of these submissions, `r nrow(df_nofinish)` were incomplete (`r nrow(df_nofinish %>% filter(EndState == "abandoned"))` surveys abandoned, and `r nrow(df_nofinish %>% filter(TerminateFlag == "Screened"))` failed screening questions.
#
# Dataframe descriptions:
#
# - `df_raw` is raw data from each qualtrics survey, combined; 1 row per Qualtrics submission ( `r nrow(df_raw)` total qualtrics attempts)
#
# - `df_raw_clean` is wrangled data from raw, with only relevant columns; 1 row per Qualtrics submission (`r nrow(df_master)` total qualtrics attempts)
#
# - `df_nofinish` is data for invalid submissions (abandonded or screened out due to not matching the pre-screening questions in prolific) (`r nrow(df_nofinish)` incomplete submissions) NOTE that these do not indicate unique participants. In some instances, the same `ID.Prolific` is associated with multiple (incomplete) attempts.
#
# - `df_data` is data for completed, valid submissions; 1 row per complete Qualtrics submission = 1 participant (`r nrow(df_data)` total valid submissions)
#
# - `df_graphs` is valid data pivoted long *without* free response questions; 1 row per participant X graph (`r nrow(df_graphs)`) participant-graph records)
#
# - `df_graphs_full` is valid data pivoted long *including* free response questions; 1 row per participant X graph (`r nrow(df_graphs_full)`) participant-graph records)
#
# - `df_subjects` is valid data (1 row per participant)1.1 PROFILE DATA
df_graphs%>% summarytools::dfSummary(
varnumbers = FALSE,
plain.ascii = FALSE,
graph.magnif = 0.75,
style = "grid",
tmp.img.dir = "temp",
missing.col = FALSE,
method = "render"
)## temporary images written to '/Users/amyraefox/Code/MAG-Magic_Visualization/MAG/Studies/S2-surveys/2_prototype/temp'## ### Data Frame Summary
## #### df_graphs
## **Dimensions:** 200 x 29
## **Duplicates:** 0
##
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | Variable | Stats / Values | Freqs (% of Valid) | Graph | Valid | Missing |
## +================+=================================+=====================+======================+==========+=========+
## | ID.Qualtrics\ | 1\. R_12JREZApC5iEqSF\ | 0 ( 0.0%)\ |  | 200\ | 0\ |
## | [factor] | 2\. R_18Mwg4NFTa8GyAh\ | 5 ( 2.5%)\ | | (100.0%) | (0.0%) |
## | | 3\. R_18SQ7VoPcbO4qzk\ | 0 ( 0.0%)\ | | | |
## | | 4\. R_19SlHzR91R4mdQ5\ | 0 ( 0.0%)\ | | | |
## | | 5\. R_1Cei7iCZO19u3Ic\ | 0 ( 0.0%)\ | | | |
## | | 6\. R_1dzvbStETdGhNLA\ | 5 ( 2.5%)\ | | | |
## | | 7\. R_1fVXHUOTf3wOcBb\ | 0 ( 0.0%)\ | | | |
## | | 8\. R_1GD3p1dgqekPgYw\ | 0 ( 0.0%)\ | | | |
## | | 9\. R_1IaC4djUHx8T0BY\ | 0 ( 0.0%)\ | | | |
## | | 10\. R_1IxXvfhtcJZw6do\ | 0 ( 0.0%)\ | | | |
## | | [ 131 others ] | 190 (95.0%) | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | ID.Prolific\ | 1\. 56e6a66af6ed900006a5867c\ | 5 ( 2.5%)\ |  | 200\ | 0\ |
## | [factor] | 2\. 56e8bf5a870a8e000b4a8d6e\ | 0 ( 0.0%)\ | | (100.0%) | (0.0%) |
## | | 3\. 574dc90512d86b000f833ab0\ | 0 ( 0.0%)\ | | | |
## | | 4\. 57dd1a741334540001170404\ | 0 ( 0.0%)\ | | | |
## | | 5\. 57f3b6bfa1100100016d1454\ | 5 ( 2.5%)\ | | | |
## | | 6\. 57fc96d6279ffd000124ccd7\ | 0 ( 0.0%)\ | | | |
## | | 7\. 5930c7fdfa699e0001017cc1\ | 0 ( 0.0%)\ | | | |
## | | 8\. 5a5da588f6c51700019527c4\ | 5 ( 2.5%)\ | | | |
## | | 9\. 5a6f57166923df0001ef8d02\ | 0 ( 0.0%)\ | | | |
## | | 10\. 5ade6e74066c510001d43903\ | 0 ( 0.0%)\ | | | |
## | | [ 101 others ] | 185 (92.5%) | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | ID.Study\ | 1\. datacollar\ | 100 (50.0%)\ |  | 200\ | 0\ |
## | [factor] | 2\. bluecollar | 100 (50.0%) | | (100.0%) | (0.0%) |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | PLATFORM\ | 1\. Facebook\ | 80 (40.0%)\ |  | 200\ | 0\ |
## | [factor] | 2\. Instagram\ | 35 (17.5%)\ | | (100.0%) | (0.0%) |
## | | 3\. LinkedIn\ | 0 ( 0.0%)\ | | | |
## | | 4\. Tumblr\ | 0 ( 0.0%)\ | | | |
## | | 5\. Twitter/X | 85 (42.5%) | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | STIMULUS\ | 1\. B0-0\ | 40 (20.0%)\ |  | 200\ | 0\ |
## | [factor] | 2\. B1-1\ | 40 (20.0%)\ | | (100.0%) | (0.0%) |
## | | 3\. B1-2\ | 40 (20.0%)\ | | | |
## | | 4\. B1-3\ | 40 (20.0%)\ | | | |
## | | 5\. B1-4\ | 40 (20.0%)\ | | | |
## | | 6\. B2-1\ | 0 ( 0.0%)\ | | | |
## | | 7\. B2-2\ | 0 ( 0.0%)\ | | | |
## | | 8\. B2-3\ | 0 ( 0.0%)\ | | | |
## | | 9\. B2-4\ | 0 ( 0.0%)\ | | | |
## | | 10\. B3-1\ | 0 ( 0.0%)\ | | | |
## | | [ 15 others ] | 0 ( 0.0%) | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | BLOCK\ | 1\. B0\ | 40 (20.0%)\ |  | 200\ | 0\ |
## | [factor] | 2\. B1\ | 160 (80.0%)\ | | (100.0%) | (0.0%) |
## | | 3\. B2\ | 0 ( 0.0%)\ | | | |
## | | 4\. B3\ | 0 ( 0.0%)\ | | | |
## | | 5\. B4\ | 0 ( 0.0%)\ | | | |
## | | 6\. B5\ | 0 ( 0.0%)\ | | | |
## | | 7\. B6 | 0 ( 0.0%) | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | ENCOUNTER\ | 1\. engage\ | 98 (49.0%)\ |  | 200\ | 0\ |
## | [factor] | 2\. scroll | 102 (51.0%) | | (100.0%) | (0.0%) |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | MAKER_ID\ | 1\. business\ | 44 (22.0%)\ |  | 200\ | 0\ |
## | [factor] | 2\. political\ | 44 (22.0%)\ | | (100.0%) | (0.0%) |
## | | 3\. education\ | 44 (22.0%)\ | | | |
## | | 4\. news\ | 38 (19.0%)\ | | | |
## | | 5\. organization\ | 9 ( 4.5%)\ | | | |
## | | 6\. individual | 21 (10.5%) | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | MAKER_CONF\ | Mean (sd) : 58.9 (22.5)\ | 70 distinct values |  | 200\ | 0\ |
## | [numeric] | min < med < max:\ | | | (100.0%) | (0.0%) |
## | | 0 < 63.5 < 100\ | | | | |
## | | IQR (CV) : 22.5 (0.4) | | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | MAKER_AGE\ | 1\. boomer\ | 17 ( 8.5%)\ |  | 200\ | 0\ |
## | [factor] | 2\. gen-x\ | 89 (44.5%)\ | | (100.0%) | (0.0%) |
## | | 3\. gen-z\ | 18 ( 9.0%)\ | | | |
## | | 4\. millenial\ | 54 (27.0%)\ | | | |
## | | 5\. millennial | 22 (11.0%) | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | AGE_CONF\ | Mean (sd) : 61.2 (19.4)\ | 63 distinct values |  | 200\ | 0\ |
## | [numeric] | min < med < max:\ | | | (100.0%) | (0.0%) |
## | | 0 < 64 < 100\ | | | | |
## | | IQR (CV) : 22.2 (0.3) | | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | MAKER_GENDER\ | 1\. Female\ | 65 (32.5%)\ |  | 200\ | 0\ |
## | [factor] | 2\. Male\ | 129 (64.5%)\ | | (100.0%) | (0.0%) |
## | | 3\. Other | 6 ( 3.0%) | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | GENDER_CONF\ | Mean (sd) : 57.5 (22.5)\ | 72 distinct values |  | 200\ | 0\ |
## | [numeric] | min < med < max:\ | | | (100.0%) | (0.0%) |
## | | 0 < 60 < 100\ | | | | |
## | | IQR (CV) : 26.8 (0.4) | | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | MAKER_DESIGN\ | Mean (sd) : 50 (27.2)\ | 77 distinct values |  | 200\ | 0\ |
## | [numeric] | min < med < max:\ | | | (100.0%) | (0.0%) |
## | | 0 < 50 < 100\ | | | | |
## | | IQR (CV) : 45.8 (0.5) | | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | MAKER_DATA\ | Mean (sd) : 45.7 (26.3)\ | 80 distinct values |  | 200\ | 0\ |
## | [numeric] | min < med < max:\ | | | (100.0%) | (0.0%) |
## | | 0 < 43 < 100\ | | | | |
## | | IQR (CV) : 42.2 (0.6) | | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | MAKER_POLITIC\ | Mean (sd) : 48.5 (20)\ | 70 distinct values |  | 200\ | 0\ |
## | [numeric] | min < med < max:\ | | | (100.0%) | (0.0%) |
## | | 0 < 50 < 100\ | | | | |
## | | IQR (CV) : 20 (0.4) | | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | MAKER_ARGUE\ | Mean (sd) : 53.9 (20.5)\ | 67 distinct values |  | 200\ | 0\ |
## | [numeric] | min < med < max:\ | | | (100.0%) | (0.0%) |
## | | 5 < 51 < 100\ | | | | |
## | | IQR (CV) : 28.5 (0.4) | | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | MAKER_SELF\ | Mean (sd) : 43.5 (18.7)\ | 67 distinct values |  | 200\ | 0\ |
## | [numeric] | min < med < max:\ | | | (100.0%) | (0.0%) |
## | | 0 < 47 < 91\ | | | | |
## | | IQR (CV) : 18 (0.4) | | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | MAKER_ALIGN\ | Mean (sd) : 50.2 (17.3)\ | 63 distinct values |  | 200\ | 0\ |
## | [numeric] | min < med < max:\ | | | (100.0%) | (0.0%) |
## | | 0 < 50 < 100\ | | | | |
## | | IQR (CV) : 17 (0.3) | | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | MAKER_TRUST\ | Mean (sd) : 58.4 (18.7)\ | 63 distinct values |  | 200\ | 0\ |
## | [numeric] | min < med < max:\ | | | (100.0%) | (0.0%) |
## | | 0 < 57 < 100\ | | | | |
## | | IQR (CV) : 21 (0.3) | | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | MAKER_LATENCY\ | Mean (sd) : 2.6 (2)\ | 156 distinct values |  | 200\ | 0\ |
## | [numeric] | min < med < max:\ | | | (100.0%) | (0.0%) |
## | | 0.5 < 2 < 20.6\ | | | | |
## | | IQR (CV) : 1.7 (0.8) | | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | TOOL_ID\ | 1\. ?\ | 24 (12.0%)\ |  | 200\ | 0\ |
## | [factor] | 2\. design_advanced\ | 40 (20.0%)\ | | (100.0%) | (0.0%) |
## | | 3\. design_advanced,programmi\ | 2 ( 1.0%)\ | | | |
## | | 4\. design_advanced,viz_advan\ | 10 ( 5.0%)\ | | | |
## | | 5\. design_advanced,viz_advan\ | 1 ( 0.5%)\ | | | |
## | | 6\. design_advanced,viz_basic\ | 2 ( 1.0%)\ | | | |
## | | 7\. design_basic\ | 41 (20.5%)\ | | | |
## | | 8\. design_basic,?\ | 1 ( 0.5%)\ | | | |
## | | 9\. design_basic,design_advan\ | 7 ( 3.5%)\ | | | |
## | | 10\. design_basic,viz_advanced\ | 4 ( 2.0%)\ | | | |
## | | [ 8 others ] | 68 (34.0%) | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | TOOL_CONF\ | Mean (sd) : 60 (22.4)\ | 69 distinct values |  | 200\ | 0\ |
## | [numeric] | min < med < max:\ | | | (100.0%) | (0.0%) |
## | | 0 < 62.5 < 100\ | | | | |
## | | IQR (CV) : 24.2 (0.4) | | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | CHART_LIKE\ | Mean (sd) : 42.2 (26.9)\ | 71 distinct values |  | 200\ | 0\ |
## | [numeric] | min < med < max:\ | | | (100.0%) | (0.0%) |
## | | 0 < 45 < 100\ | | | | |
## | | IQR (CV) : 41.2 (0.6) | | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | CHART_BEAUTY\ | Mean (sd) : 43.7 (29.1)\ | 73 distinct values |  | 200\ | 0\ |
## | [numeric] | min < med < max:\ | | | (100.0%) | (0.0%) |
## | | 0 < 49 < 100\ | | | | |
## | | IQR (CV) : 49.2 (0.7) | | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | CHART_INTENT\ | Mean (sd) : 40.5 (30.2)\ | 78 distinct values |  | 200\ | 0\ |
## | [numeric] | min < med < max:\ | | | (100.0%) | (0.0%) |
## | | 0 < 36 < 100\ | | | | |
## | | IQR (CV) : 49 (0.7) | | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | CHART_TRUST\ | Mean (sd) : 54.2 (22.3)\ | 64 distinct values |  | 200\ | 0\ |
## | [numeric] | min < med < max:\ | | | (100.0%) | (0.0%) |
## | | 0 < 52 < 100\ | | | | |
## | | IQR (CV) : 26.5 (0.4) | | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | CHART_LATENCY\ | Mean (sd) : 2.2 (1.6)\ | 149 distinct values |  | 200\ | 0\ |
## | [numeric] | min < med < max:\ | | | (100.0%) | (0.0%) |
## | | 0.4 < 1.7 < 11.8\ | | | | |
## | | IQR (CV) : 1.4 (0.8) | | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+
## | loop_number\ | Mean (sd) : 2 (1.4)\ | 0 : 40 (20.0%)\ |  | 200\ | 0\ |
## | [numeric] | min < med < max:\ | 1 : 40 (20.0%)\ | | (100.0%) | (0.0%) |
## | | 0 < 2 < 4\ | 2 : 40 (20.0%)\ | | | |
## | | IQR (CV) : 2 (0.7) | 3 : 40 (20.0%)\ | | | |
## | | | 4 : 40 (20.0%) | | | |
## +----------------+---------------------------------+---------------------+----------------------+----------+---------+1.2 EDA | DEMOGRAPHICS
# SURVEY RESPONSE TIME
ggplot(data = df_qda, aes( x = duration.min, fill = ID.Study)) +
geom_density(alpha = 0.5) +
labs( title = "TOTAL Response Time by Sample") +
easy_add_legend_title("Sample") +
theme_minimal()
# MAKER PAGE RESPONSE TIME
ggplot(df_graphs, aes(x=STIMULUS, y=MAKER_LATENCY, color=ID.Study)) +
geom_boxplot(position=position_dodge(0.9))+
geom_jitter(position=position_jitterdodge(), alpha = 0.3) +
labs( title = "MAKER Page Response Time by Sample") +
easy_add_legend_title("Sample")+
theme_minimal() 
# CHART PAGE RESPONSE TIME
ggplot(df_graphs, aes(x=STIMULUS, y=CHART_LATENCY, color=ID.Study)) +
geom_boxplot(position=position_dodge(0.9))+
geom_jitter(position=position_jitterdodge(), alpha = 0.3) +
labs( title = "CHART Page Response Time by Sample") +
easy_add_legend_title("Sample")+
theme_minimal() 
# EDUCATION by SAMPLE
ggplot(data = df_data, aes( x = D_education, fill = ID.Study )) +
geom_bar(position = position_dodge()) +
labs( title = "EDUCATION by Sample", x = "") +
theme_minimal() +
# easy_remove_x_axis() +
easy_add_legend_title("Sample")
# AGE by SAMPLE
ggplot(data = df_data, aes( x = D_age, fill = ID.Study )) +
geom_bar(position = position_dodge()) +
labs( title = "AGE by Sample", x = "") +
theme_minimal() +
# easy_remove_x_axis() +
easy_add_legend_title("")
# POLITICAL PARTY
ggplot(data = df_data, aes( x = D_politicalParty, fill = ID.Study )) +
geom_bar(position = position_dodge()) +
labs( title = "POLITICAL PARTY by Sample", x = "") +
theme_minimal() +
easy_add_legend_title("")
# SOCIAL POLITICAL SAMPLE
vals <- c("bluecollar", "datacollar")
leftside <- c("liberal", "liberal")
rightside <- c("conservative", "conservative")
g <- ggplot(df_data, aes(x=ID.Study, y=D_politicsSocial, color=ID.Study)) +
geom_boxplot(position=position_dodge(0.9), width = 0.5)+
geom_jitter(position=position_jitterdodge(), alpha = 0.3) +
labs( title = "SOCIAL VALUES by Sample",
y = "Social Politics", x = "") +
easy_add_legend_title("Sample") +
theme_minimal() +
coord_flip()
g + guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) ## Warning: Removed 10 rows containing non-finite values (`stat_boxplot()`).## Warning: Removed 10 rows containing missing values (`geom_point()`).
# FISCAL POLITICAL SAMPLE
vals <- c("bluecollar", "datacollar")
leftside <- c("liberal", "liberal")
rightside <- c("conservative", "conservative")
g <- ggplot(df_data, aes(x=ID.Study, y=D_politicsFiscal, color=ID.Study)) +
geom_boxplot(position=position_dodge(0.9), width = 0.5)+
geom_jitter(position=position_jitterdodge(), alpha = 0.3) +
labs( title = "FISCAL VALUES by Sample",
y = "Fiscal Politics", x = "") +
easy_add_legend_title("Sample") +
theme_minimal() +
coord_flip()
g + guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) ## Warning: Removed 10 rows containing non-finite values (`stat_boxplot()`).
## Removed 10 rows containing missing values (`geom_point()`).
# FISCAL (VS) SOCIAL SAMPLE
ggplot(df_data, aes( x = D_politicsFiscal, y= D_politicsSocial, color = ID.Study)) +
geom_point(alpha = 0.5) +
theme_minimal() +
easy_add_legend_title("") +
labs(title = "Social (vs) Fiscal Political Values by Sample",
x = "Fiscal Values (liberal<-->conservative)",
y = "Social Values (liberal<-->conservative)")## Warning: Removed 10 rows containing missing values (`geom_point()`).
#PLATFORM CHOICE
ggplot( df_data, aes( x = PLATFORM, fill = ID.Study)) +
geom_bar(position = "dodge") +
easy_add_legend_title("") +
theme_minimal()
2 BLOCK 0
2.1 MAKER-ID
#FILTER DATAFRAME
df <- df_graphs %>% filter(STIMULUS == "B0-0")
# BEHAVIOUR CHOICE
ggplot (df, aes ( x = ENCOUNTER, fill = ID.Study)) +
geom_bar(position = "dodge") +
labs (title = "BLOCK 0 — BEHAVIOR by Sample", x="") +
theme_minimal() +
easy_remove_legend()
######### MAKER ID AND CONFIDENCE ##############
# MAKER_ID by Sample and BEHAVIOR
a <- ggplot (df, aes( x = MAKER_ID, fill = ID.Study)) +
geom_bar(position = "dodge") +
facet_grid( df$ENCOUNTER) +
labs (x = "") +
theme_minimal() +
easy_remove_legend()
# MAKER_CONFIDENCE by IDENTIFICATION
b <- ggplot(df, aes( x = MAKER_ID, y = MAKER_CONF, color = ID.Study)) +
# geom_boxplot(position=position_dodge(0.9))+
geom_jitter(position=position_jitterdodge(), alpha = 0.3) +
# labs (title = "MAKER-ID-CONFIDENCE") +
labs (x = "") +
theme_minimal() +
easy_remove_legend()
(p <- (a / b ) + plot_annotation(
title = 'MAKER ID & CONFIDENCE',
subtitle = '',
caption = ''))
###################################################
######### MAKER ID AND CONFIDENCE ##############
# MAKER_AGE by Sample and BEHAVIOR
a <- ggplot (df, aes( x = MAKER_AGE, fill = ID.Study)) +
geom_bar(position = "dodge") +
facet_grid( df$ENCOUNTER) +
labs (x = "") +
theme_minimal() +
easy_remove_legend()
# MAKER_CONFIDENCE by IDENTIFICATION
b <- ggplot(df, aes( x = MAKER_AGE, y = MAKER_CONF, color = ID.Study)) +
# geom_boxplot(position=position_dodge(0.9))+
geom_jitter(position=position_jitterdodge(), alpha = 0.3) +
# labs (title = "MAKER-AGE-CONFIDENCE") +
labs (x = "") +
theme_minimal() +
easy_remove_legend()
(p <- (a / b ) + plot_annotation(
title = 'MAKER AGE & CONFIDENCE',
subtitle = '',
caption = ''))
###################################################2.1.1 B0 MAKER
#FILTER DATAFRAME
df <- df_graphs %>% filter(STIMULUS == "B0-0")
######### MAKER ATTRIBUTES ########################
vals = c("datacollar", "bluecollar")
leftside <- rep ("PROFESSIONAL", 2 )
rightside <-rep ("LAYPERSON", 2 )
b00_m_design <- ggplot(df, aes(y = MAKER_DESIGN, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-DESIGN")
b00_m_data <- ggplot(df, aes(y = MAKER_DATA, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-DATA")
leftside <- rep ("LEFT-WING", 2 )
rightside <-rep ("RIGHT-WING", 2 )
b00_m_politics <- ggplot(df, aes(y = MAKER_POLITIC, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-POLITICS")
leftside <- rep ("CONFRONTATIONAL", 2 )
rightside <-rep ("DIPLOMATIC", 2 )
b00_m_argue <- ggplot(df, aes(y = MAKER_ARGUE, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-ARGUE")
leftside <- rep ("ALTRUSITC", 2 )
rightside <-rep ("SELFISH", 2 )
b00_m_selfish <- ggplot(df, aes(y = MAKER_SELF, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-SELFISH")
leftside <- rep ("Does NOT", 2 )
rightside <-rep ("DOES", 2 )
b00_m_align <- ggplot(df, aes(y = MAKER_ALIGN, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-SHARES-MY-VALUES")
leftside <- rep ("UNTRUSTWORTHY", 2 )
rightside <-rep ("TRUSTWORTHY", 2 )
b00_m_trust <- ggplot(df, aes(y = MAKER_TRUST, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-TRUST")
PLOT_b0_maker <- (b00_m_design / b00_m_data / b00_m_politics / b00_m_argue / b00_m_selfish / b00_m_align / b00_m_trust) +
plot_annotation(
title = "STIMULUS B0 — MILLENIAL PINK PLANTS"
)
PLOT_b0_maker
###################################################2.1.2 B1-1 MAKER
#FILTER DATAFRAME
df <- df_graphs %>% filter(STIMULUS == "B1-1")
######### MAKER ATTRIBUTES ########################
vals = c("datacollar", "bluecollar")
leftside <- rep ("PROFESSIONAL", 2 )
rightside <-rep ("LAYPERSON", 2 )
b11_m_design <- ggplot(df, aes(y = MAKER_DESIGN, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-DESIGN")
b11_m_data <- ggplot(df, aes(y = MAKER_DATA, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-DATA")
leftside <- rep ("LEFT-WING", 2 )
rightside <-rep ("RIGHT-WING", 2 )
b11_m_politics <- ggplot(df, aes(y = MAKER_POLITIC, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-POLITICS")
leftside <- rep ("CONFRONTATIONAL", 2 )
rightside <-rep ("DIPLOMATIC", 2 )
b11_m_argue <- ggplot(df, aes(y = MAKER_ARGUE, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-ARGUE")
leftside <- rep ("ALTRUSITC", 2 )
rightside <-rep ("SELFISH", 2 )
b11_m_selfish <- ggplot(df, aes(y = MAKER_SELF, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-SELFISH")
leftside <- rep ("Does NOT", 2 )
rightside <-rep ("DOES", 2 )
b11_m_align <- ggplot(df, aes(y = MAKER_ALIGN, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-SHARES-MY-VALUES")
leftside <- rep ("UNTRUSTWORTHY", 2 )
rightside <-rep ("TRUSTWORTHY", 2 )
b11_m_trust <- ggplot(df, aes(y = MAKER_TRUST, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-TRUST")
PLOT_b1_1_maker <- (b11_m_design / b11_m_data / b11_m_politics / b11_m_argue / b11_m_selfish / b11_m_align / b11_m_trust) +
plot_annotation(
title = "STIMULUS B1-1 FUSCIA HEAT MAP"
)
PLOT_b1_1_maker
###################################################2.1.3 B1-2 MAKER
#FILTER DATAFRAME
df <- df_graphs %>% filter(STIMULUS == "B1-2")
######### MAKER ATTRIBUTES ########################
vals = c("datacollar", "bluecollar")
leftside <- rep ("PROFESSIONAL", 2 )
rightside <-rep ("LAYPERSON", 2 )
b12_m_design <- ggplot(df, aes(y = MAKER_DESIGN, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-DESIGN")
b12_m_data <- ggplot(df, aes(y = MAKER_DATA, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-DATA")
leftside <- rep ("LEFT-WING", 2 )
rightside <-rep ("RIGHT-WING", 2 )
b12_m_politics <- ggplot(df, aes(y = MAKER_POLITIC, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-POLITICS")
leftside <- rep ("CONFRONTATIONAL", 2 )
rightside <-rep ("DIPLOMATIC", 2 )
b12_m_argue <- ggplot(df, aes(y = MAKER_ARGUE, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-ARGUE")
leftside <- rep ("ALTRUSITC", 2 )
rightside <-rep ("SELFISH", 2 )
b12_m_selfish <- ggplot(df, aes(y = MAKER_SELF, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-SELFISH")
leftside <- rep ("Does NOT", 2 )
rightside <-rep ("DOES", 2 )
b12_m_align <- ggplot(df, aes(y = MAKER_ALIGN, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-SHARES-MY-VALUES")
leftside <- rep ("UNTRUSTWORTHY", 2 )
rightside <-rep ("TRUSTWORTHY", 2 )
b12_m_trust <- ggplot(df, aes(y = MAKER_TRUST, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-TRUST")
PLOT_b1_2_maker <- (b12_m_design / b12_m_data / b12_m_politics / b12_m_argue / b12_m_selfish / b12_m_align / b12_m_trust) +
plot_annotation(
title = "STIMULUS B1-2 — NEWSY DUAL TIMESERIES"
)
PLOT_b1_2_maker
###################################################2.1.4 B1-3 MAKER
#FILTER DATAFRAME
df <- df_graphs %>% filter(STIMULUS == "B1-3")
######### MAKER ATTRIBUTES ########################
vals = c("datacollar", "bluecollar")
leftside <- rep ("PROFESSIONAL", 2 )
rightside <-rep ("LAYPERSON", 2 )
b13_m_design <- ggplot(df, aes(y = MAKER_DESIGN, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-DESIGN")
b13_m_data <- ggplot(df, aes(y = MAKER_DATA, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-DATA")
leftside <- rep ("LEFT-WING", 2 )
rightside <-rep ("RIGHT-WING", 2 )
b13_m_politics <- ggplot(df, aes(y = MAKER_POLITIC, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-POLITICS")
leftside <- rep ("CONFRONTATIONAL", 2 )
rightside <-rep ("DIPLOMATIC", 2 )
b13_m_argue <- ggplot(df, aes(y = MAKER_ARGUE, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-ARGUE")
leftside <- rep ("ALTRUSITC", 2 )
rightside <-rep ("SELFISH", 2 )
b13_m_selfish <- ggplot(df, aes(y = MAKER_SELF, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-SELFISH")
leftside <- rep ("Does NOT", 2 )
rightside <-rep ("DOES", 2 )
b13_m_align <- ggplot(df, aes(y = MAKER_ALIGN, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-SHARES-MY-VALUES")
leftside <- rep ("UNTRUSTWORTHY", 2 )
rightside <-rep ("TRUSTWORTHY", 2 )
b13_m_trust <- ggplot(df, aes(y = MAKER_TRUST, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-TRUST")
PLOT_b1_3_maker <- (b13_m_design / b13_m_data / b13_m_politics / b13_m_argue / b13_m_selfish / b13_m_align / b13_m_trust) +
plot_annotation(
title = "STIMULUS B1-3 — STACKED AMERICAN FLAG"
)
PLOT_b1_3_maker
###################################################2.1.5 B1-4 MAKER
#FILTER DATAFRAME
df <- df_graphs %>% filter(STIMULUS == "B1-4")
######### MAKER ATTRIBUTES ########################
vals = c("datacollar", "bluecollar")
leftside <- rep ("PROFESSIONAL", 2 )
rightside <-rep ("LAYPERSON", 2 )
b14_m_design <- ggplot(df, aes(y = MAKER_DESIGN, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-DESIGN")
b14_m_data <- ggplot(df, aes(y = MAKER_DATA, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-DATA")
leftside <- rep ("LEFT-WING", 2 )
rightside <-rep ("RIGHT-WING", 2 )
b14_m_politics <- ggplot(df, aes(y = MAKER_POLITIC, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-POLITICS")
leftside <- rep ("CONFRONTATIONAL", 2 )
rightside <-rep ("DIPLOMATIC", 2 )
b14_m_argue <- ggplot(df, aes(y = MAKER_ARGUE, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-ARGUE")
leftside <- rep ("ALTRUSITC", 2 )
rightside <-rep ("SELFISH", 2 )
b14_m_selfish <- ggplot(df, aes(y = MAKER_SELF, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-SELFISH")
leftside <- rep ("Does NOT", 2 )
rightside <-rep ("DOES", 2 )
b14_m_align <- ggplot(df, aes(y = MAKER_ALIGN, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-SHARES-MY-VALUES")
leftside <- rep ("UNTRUSTWORTHY", 2 )
rightside <-rep ("TRUSTWORTHY", 2 )
b14_m_trust <- ggplot(df, aes(y = MAKER_TRUST, x = ID.Study, color = ID.Study))+
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
theme_minimal() +
easy_remove_legend() +
guides(
y = guide_axis_manual(
breaks = vals,
labels = leftside
),
y.sec = guide_axis_manual(
breaks = vals,
labels = rightside
)) +
labs(title = "MAKER-TRUST")
PLOT_b1_4_maker <- (b14_m_design / b14_m_data / b14_m_politics / b14_m_argue / b14_m_selfish / b14_m_align / b14_m_trust) +
plot_annotation(
title = "STIMULUS B1-4 — TINY-PEOPLE-GUNS"
)
PLOT_b1_4_maker
##################################################### BLOCK O,1 MAKER_TRUST
b00_m_politics / b11_m_politics / b12_m_politics / b13_m_politics / b14_m_politics
# gf_histogram( ~ MAKER_TRUST, data = df_graphs) %>%
# gf_facet_grid(STIMULUS ~ .) %>% easy_labs( title = "MAKER TRUST by GRAPH")
#
# gf_histogram( ~ CHART_TRUST, data = df_graphs) %>%
# gf_facet_grid(STIMULUS ~ .) %>% easy_labs( title = "CHART TRUST by GRAPH")
#
#
# gf_histogram( ~ MAKER_CONF, data = df_graphs) %>% easy_labs( title = "MAKER CONF by GRAPH")
# # %>%
# gf_facet_grid(STIMULUS ~ .)
# # #MAKER CHARS
# df <- df_graphs %>% select(ID.Study:STIMULUS, ENCOUNTER, MAKER_ID:MAKER_LATENCY) %>%
# mutate(
# STIMULUS = factor(STIMULUS) #refactor to get rid of extra empty levels
# )
#
# #MAKER CHARS
# df <- df_graphs %>% select(ID.Study:STIMULUS, ENCOUNTER, MAKER_ID:MAKER_LATENCY) %>%
# mutate(
# STIMULUS = factor(STIMULUS) #refactor to get rid of extra empty levels
# )
#
# ## CHART
# df <- df_graphs %>% select(ID.Study, STIMULUS, ENCOUNTER, CHART_LIKE:loop_number) %>%
# mutate(
# STIMULUS = factor(STIMULUS) #refactor to get rid of extra empty levels
# )
#
# ggpairs(df, mapping = aes(color = STIMULUS))
#
## MAKER CHARACTERISTICS
df_1 <- df_graphs %>%
# filter(STIMULUS == "B0-0") %>%
select(ID.Study, MAKER_ID, MAKER_AGE, MAKER_GENDER,
MAKER_DESIGN: MAKER_TRUST)
g <- ggpairs(df_1,
mapping = aes(color = ID.Study, alpha = 0.05),
showStrips = TRUE,
title = "STIMULUS 0 MAKER CHARACTERISTICS BY SAMPLE") +
theme_minimal()
g
##STATSPLOT
grouped_ggwithinstats(
data = df_graphs,
x = STIMULUS,
y = CHART_TRUST,
grouping.var = ID.Study
) 
grouped_ggscatterstats(
data = df_graphs, ## data frame from which variables are taken
x = CHART_BEAUTY, ## predictor/independent variable
y = CHART_TRUST, ## dependent variable
grouping.var = ID.Study,
xlab = "CHART TRUST", ## label for the x-axis
ylab = "MAKER TRUST", ## label for the y-axis
# label.expression = rating < 5 & budget > 100, ## expression for deciding which points to label
point.label.args = list(alpha = 0.7, size = 4, color = "grey50"),
xfill = "#CC79A7", ## fill for marginals on the x-axis
yfill = "#009E73" ## fill for marginals on the y-axis
# title = "CHART TRUST (VS) MAKER TRUST",
# caption = ""
)
gf_point( data = df_graphs, MAKER_TRUST~CHART_TRUST, color = ~STIMULUS) %>% gf_facet_wrap(~STIMULUS)
gf_point( data = df_graphs, MAKER_ALIGN~CHART_BEAUTY, color = ~STIMULUS) %>% gf_facet_wrap(~STIMULUS)
### little model
df <- df_graphs %>% filter(STIMULUS == "B0-0")
m <- lm( CHART_TRUST ~ CHART_BEAUTY,data = df)
summary(m)##
## Call:
## lm(formula = CHART_TRUST ~ CHART_BEAUTY, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -40.068 -10.242 -1.839 8.163 39.932
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 40.0684 5.4192 7.394 7.26e-09 ***
## CHART_BEAUTY 0.3350 0.1109 3.020 0.0045 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 20.17 on 38 degrees of freedom
## Multiple R-squared: 0.1935, Adjusted R-squared: 0.1723
## F-statistic: 9.12 on 1 and 38 DF, p-value: 0.004503ggnostic(m) #GGALLY MODEL CHECKS## `geom_smooth()` using method = 'loess'
check_model(m) #EASY STATS MODEL CHECKS 
### MORE COMPLEX MODEL
df <- df_graphs %>% filter(STIMULUS != "B0-0")
m1 <- lmer(CHART_TRUST ~ CHART_BEAUTY + (1|ID.Qualtrics), data = df)
m2 <- lmer(CHART_TRUST ~ CHART_BEAUTY + (1|STIMULUS), data = df)
m3 <- lmer(CHART_TRUST ~ CHART_BEAUTY + (1 | STIMULUS) + (1 | ID.Qualtrics), data = df)
summary(m1)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: CHART_TRUST ~ CHART_BEAUTY + (1 | ID.Qualtrics)
## Data: df
##
## REML criterion at convergence: 1406.8
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.17027 -0.60707 0.07936 0.55782 2.13035
##
## Random effects:
## Groups Name Variance Std.Dev.
## ID.Qualtrics (Intercept) 47.61 6.90
## Residual 348.04 18.66
## Number of obs: 160, groups: ID.Qualtrics, 40
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 38.09971 3.02695 116.12191 12.587 < 2e-16 ***
## CHART_BEAUTY 0.36515 0.05383 157.23898 6.783 2.25e-10 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## CHART_BEAUT -0.795summary(m2)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: CHART_TRUST ~ CHART_BEAUTY + (1 | STIMULUS)
## Data: df
##
## REML criterion at convergence: 1388.3
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.17519 -0.53022 -0.02523 0.68919 2.94282
##
## Random effects:
## Groups Name Variance Std.Dev.
## STIMULUS (Intercept) 87.8 9.37
## Residual 328.8 18.13
## Number of obs: 160, groups: STIMULUS, 4
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 37.28349 5.39726 4.39766 6.908 0.00161 **
## CHART_BEAUTY 0.38340 0.05062 156.20420 7.575 2.96e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## CHART_BEAUT -0.419summary(m3)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: CHART_TRUST ~ CHART_BEAUTY + (1 | STIMULUS) + (1 | ID.Qualtrics)
## Data: df
##
## REML criterion at convergence: 1379.1
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.08513 -0.54837 -0.00856 0.66150 2.38751
##
## Random effects:
## Groups Name Variance Std.Dev.
## ID.Qualtrics (Intercept) 72.43 8.511
## STIMULUS (Intercept) 91.00 9.539
## Residual 256.45 16.014
## Number of obs: 160, groups: ID.Qualtrics, 40; STIMULUS, 4
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 36.35331 5.56417 4.81845 6.533 0.00145 **
## CHART_BEAUTY 0.40420 0.04897 151.64537 8.254 6.93e-14 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## CHART_BEAUT -0.394compare_parameters(m1,m2,m3)## Parameter | m1 | m2 | m3
## ---------------------------------------------------------------------------------
## (Intercept) | 38.10 (32.12, 44.08) | 37.28 (26.62, 47.94) | 36.35 (25.36, 47.34)
## CHART BEAUTY | 0.37 ( 0.26, 0.47) | 0.38 ( 0.28, 0.48) | 0.40 ( 0.31, 0.50)
## ---------------------------------------------------------------------------------
## Observations | 160 | 160 | 160compare_performance(m1,m2,m3, rank = TRUE)## Some of the nested models seem to be identical and probably only vary in
## their random effects.## # Comparison of Model Performance Indices
##
## Name | Model | R2 (cond.) | R2 (marg.) | ICC | RMSE | Sigma | AIC weights | AICc weights | BIC weights | Performance-Score
## -----------------------------------------------------------------------------------------------------------------------------------------
## m3 | lmerModLmerTest | 0.540 | 0.247 | 0.389 | 14.689 | 16.014 | 0.972 | 0.971 | 0.884 | 100.00%
## m2 | lmerModLmerTest | 0.392 | 0.230 | 0.211 | 17.861 | 18.132 | 0.027 | 0.029 | 0.116 | 17.22%
## m1 | lmerModLmerTest | 0.315 | 0.222 | 0.120 | 17.716 | 18.656 | 6.35e-06 | 6.77e-06 | 2.69e-05 | 0.57%m <- lmer(CHART_TRUST ~ CHART_BEAUTY + MAKER_TRUST + (1 | STIMULUS) , data = df)
mi <- lmer(CHART_TRUST ~ CHART_BEAUTY * MAKER_TRUST + (1 | STIMULUS) , data = df)## Warning: Some predictor variables are on very different scales: consider
## rescaling
## Warning: Some predictor variables are on very different scales: consider
## rescalingsummary(m)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: CHART_TRUST ~ CHART_BEAUTY + MAKER_TRUST + (1 | STIMULUS)
## Data: df
##
## REML criterion at convergence: 1282.7
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.9730 -0.6087 0.0802 0.6014 2.7701
##
## Random effects:
## Groups Name Variance Std.Dev.
## STIMULUS (Intercept) 21.15 4.599
## Residual 167.67 12.949
## Number of obs: 160, groups: STIMULUS, 4
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 3.85095 4.00589 17.30123 0.961 0.35
## CHART_BEAUTY 0.17606 0.03958 156.83248 4.448 1.63e-05 ***
## MAKER_TRUST 0.74825 0.05948 156.99959 12.581 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) CHART_
## CHART_BEAUT -0.093
## MAKER_TRUST -0.666 -0.411summary(mi)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: CHART_TRUST ~ CHART_BEAUTY * MAKER_TRUST + (1 | STIMULUS)
## Data: df
##
## REML criterion at convergence: 1293.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.9678 -0.6130 0.0815 0.6099 2.7576
##
## Random effects:
## Groups Name Variance Std.Dev.
## STIMULUS (Intercept) 21.71 4.66
## Residual 168.64 12.99
## Number of obs: 160, groups: STIMULUS, 4
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 4.637e+00 5.517e+00 4.633e+01 0.841 0.405
## CHART_BEAUTY 1.540e-01 1.144e-01 1.549e+02 1.345 0.180
## MAKER_TRUST 7.334e-01 9.257e-02 1.560e+02 7.923 4.1e-13 ***
## CHART_BEAUTY:MAKER_TRUST 3.789e-04 1.833e-03 1.552e+02 0.207 0.837
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) CHART_BEAUTY MAKER_
## CHART_BEAUTY -0.664
## MAKER_TRUST -0.834 0.625
## CHART_BEAUTY: 0.683 -0.938 -0.765
## fit warnings:
## Some predictor variables are on very different scales: consider rescalingcompare_performance(m3,m,mi, rank = TRUE)## # Comparison of Model Performance Indices
##
## Name | Model | R2 (cond.) | R2 (marg.) | ICC | RMSE | Sigma | AIC weights | AICc weights | BIC weights | Performance-Score
## -----------------------------------------------------------------------------------------------------------------------------------------
## m | lmerModLmerTest | 0.655 | 0.611 | 0.112 | 12.725 | 12.949 | 0.728 | 0.744 | 0.926 | 87.47%
## mi | lmerModLmerTest | 0.654 | 0.609 | 0.114 | 12.720 | 12.986 | 0.272 | 0.256 | 0.074 | 59.72%
## m3 | lmerModLmerTest | 0.540 | 0.247 | 0.389 | 14.689 | 16.014 | 4.55e-23 | 4.65e-23 | 5.79e-23 | 12.50%#todo see https://yury-zablotski.netlify.app/post/mixed-effects-models-2/ about fitting with ML vs REML for model comparison # #TODO WALK THROUGH THIS
# #https://yury-zablotski.netlify.app/post/mixed-models/#multiple-random-slope-model
#
# #load example data
# data("sleepstudy")
#
# #fit the model
# m_slp <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy)
#
# #the next line put all the estimated intercept and slope per subject into a dataframe
# reaction_slp <- as.data.frame(t(apply(ranef(m_slp)$Subject, 1,function(x) fixef(m_slp) + x)))
#
# #to get the predicted regression lines we need one further step, writing the linear equation: Intercept + Slope*Days with different coefficient for each subject
# pred_slp <- melt(apply(reaction_slp,1,function(x) x[1] + x[2]*0:9), value.name = "Reaction")
#
# #some re-formatting for the plot
# names(pred_slp)[1:2] <- c("Days","Subject")
# pred_slp$Days <- pred_slp$Days - 1
# pred_slp$Subject <- as.factor(pred_slp$Subject)
#
# #plot with actual data
# ggplot(pred_slp,aes(x=Days,y=Reaction,color=Subject))+
# geom_line()+
# geom_point(data=sleepstudy,aes(x=Days,y=Reaction))+
# facet_wrap(~Subject,nrow=3)